;;; Test Scheme procedures related to path objects.

(use-modules (lepton object))

(test-begin "paths")

(let* ((a (make-path))
       (b (make-path 21)))

  (test-equal 'path (object-type a))
  (test-assert (object-type? a 'path))
  (test-assert (not (object-type? a 'x)))
  (test-assert (path? a))
  (test-equal 0 (path-length a))
  (test-assert-thrown 'out-of-range (path-ref a 0))
  (test-assert-thrown 'out-of-range (path-remove! a 0))
  (test-equal #f (object-bounds a))

  ;; Most trivial path possible
  (test-equal a (path-insert! a -1 'lineto '(0 . 0)))
  (test-equal 1 (path-length a))
  (test-equal '(lineto (0 . 0)) (path-ref a 0))
  (test-equal '((-8 . 8) . (8 . -8)) (object-bounds a))

  ;; Add a move to the start
  (test-equal a (path-insert! a 0 'moveto '(1 . 0)))
  (test-equal 2 (path-length a))
  (test-equal '(moveto (1 . 0)) (path-ref a 0))
  (test-equal '(lineto (0 . 0)) (path-ref a 1))
  (test-equal '((-8 . 8) . (9 . -8)) (object-bounds a))

  ;; Remove the line
  (test-equal a (path-remove! a 1))
  (test-equal 1 (path-length a))
  (test-assert-thrown 'out-of-range (path-ref a 1))
  (test-assert-thrown 'out-of-range (path-remove! a 1))
  (test-equal '((-7 . 8) . (9 . -8)) (object-bounds a))

  ;; Add a line, a curve and a closepath.
  (test-equal a (path-insert! a -1 'lineto '(1 . 2)))
  (test-equal '(lineto (1 . 2)) (path-ref a 1))
  (test-equal a (path-insert! a -1 'curveto
                              '(3 . 4) '(5 . 6) '(7 . 8)))
  (test-equal '(curveto (3 . 4) (5 . 6) (7 . 8)) (path-ref a 2))
  (test-equal a (path-insert! a -1 'closepath))
  (test-equal '(closepath) (path-ref a 3))

  (test-equal a (path-remove! a 1))

  ;; Bad path element type
  (test-assert-thrown 'misc-error (path-insert! a -1 'BAD-VALUE))

  ;; Color
  (test-equal 21 (object-color b))
  )

(test-end "paths")

(define (new-path)
  (let ((p (make-path)))
    (path-insert! p -1 'moveto '(-200 . -200))
    (path-insert! p -1 'lineto '(-200 . 400))
    (path-insert! p -1 'lineto '(200 . 400))
    (path-insert! p -1 'curveto '(200 . 400) '(500 . 400) '(500 . 100))
    (path-insert! p -1 'curveto '(500 . -200) '(200 . -200) '(200 . -200))
    (path-insert! p -1 'closepath)
    p))


(test-begin "path-wrong-argument")

;;; Wrong color in make-path.
(test-assert-thrown 'wrong-type-arg (make-path 'color))

;;; path-info
(test-assert-thrown 'wrong-type-arg (path-info 'p))

;;; path-length
(test-assert-thrown 'wrong-type-arg (path-length 'p))

;;; path-ref
(test-assert-thrown 'wrong-type-arg (path-ref 'p 0))
(test-assert-thrown 'wrong-type-arg (path-ref (new-path) 'x))
;;; path-ref out of range index.
(test-assert-thrown 'out-of-range (path-ref (new-path) -1))
(test-assert-thrown 'out-of-range (path-ref (new-path) 100))

;;; path-remove!
(test-assert-thrown 'wrong-type-arg (path-remove! 'p 0))
(test-assert-thrown 'wrong-type-arg (path-remove! (new-path) 'x))
;;; path-remove! out of range index.
(test-assert-thrown 'out-of-range (path-remove! (new-path) -1))
(test-assert-thrown 'out-of-range (path-remove! (new-path) 100))

;;; path-insert!
(let ((p (new-path)))
  ;; Wrong object.
  (test-assert-thrown 'wrong-type-arg (path-insert! 'p -1 'moveto '(-200 . -200)))
  (test-assert-thrown 'wrong-type-arg (path-insert! 'p -1 'lineto '(200 . 400)))
  (test-assert-thrown 'wrong-type-arg (path-insert! 'p -1 'curveto '(200 . 400) '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! 'p -1 'closepath))
  ;; Wrong index.
  (test-assert-thrown 'wrong-type-arg (path-insert! p 'id 'moveto '(-200 . -200)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p 'id 'lineto '(200 . 400)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p 'id 'curveto '(200 . 400) '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p 'id 'closepath))
  ;; Wrong section name.
  (test-assert-thrown 'misc-error (path-insert! p -1 'move '(-200 . -200)))
  (test-assert-thrown 'misc-error (path-insert! p -1 'line '(200 . 400)))
  (test-assert-thrown 'misc-error (path-insert! p -1 'curve '(200 . 400) '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'misc-error (path-insert! p -1 'close))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 100 '(-200 . -200)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 100 '(200 . 400)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 100 '(200 . 400) '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 100))
  ;; Wrong coord.
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'moveto 'c))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'lineto 'c))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto 'c '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . 400) 'c '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . 400) '(500 . 400) 'c))
  ;; Wrong x.
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'moveto '(x . -200)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'lineto '(x . 400)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(x . 400) '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . 400) '(x . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . 400) '(500 . 400) '(x . 100)))
  ;; Wrong y.
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'moveto '(-200 . y)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'lineto '(200 . y)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . y) '(500 . 400) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . 400) '(500 . y) '(500 . 100)))
  (test-assert-thrown 'wrong-type-arg (path-insert! p -1 'curveto '(200 . 400) '(500 . 400) '(500 . y))))

(test-end "path-wrong-argument")


(test-begin "path-translation")

(test-equal (path-info (car (translate-objects! '(500 . 500) (new-path))))
  '((moveto (300 . 300))
    (lineto (300 . 900))
    (lineto (700 . 900))
    (curveto (700 . 900) (1000 . 900) (1000 . 600))
    (curveto (1000 . 300) (700 . 300) (700 . 300))
    (closepath)))
(test-equal (path-info (car (translate-objects! '(-500 . 500) (new-path))))
  '((moveto (-700 . 300))
    (lineto (-700 . 900))
    (lineto (-300 . 900))
    (curveto (-300 . 900) (0 . 900) (0 . 600))
    (curveto (0 . 300) (-300 . 300) (-300 . 300))
    (closepath)))
(test-equal (path-info (car (translate-objects! '(500 . -500) (new-path))))
  '((moveto (300 . -700))
    (lineto (300 . -100))
    (lineto (700 . -100))
    (curveto (700 . -100) (1000 . -100) (1000 . -400))
    (curveto (1000 . -700) (700 . -700) (700 . -700))
    (closepath)))
(test-equal (path-info (car (translate-objects! '(-500 . -500) (new-path))))
  '((moveto (-700 . -700))
    (lineto (-700 . -100))
    (lineto (-300 . -100))
    (curveto (-300 . -100) (0 . -100) (0 . -400))
    (curveto (0 . -700) (-300 . -700) (-300 . -700))
    (closepath)))

(test-end "path-translation")


(test-begin "path-mirror")

(test-equal (path-info (car (mirror-objects! 0 (new-path))))
  '((moveto (200 . -200))
    (lineto (200 . 400))
    (lineto (-200 . 400))
    (curveto (-200 . 400) (-500 . 400) (-500 . 100))
    (curveto (-500 . -200) (-200 . -200) (-200 . -200))
    (closepath)))
(test-equal (path-info (car (mirror-objects! 500 (new-path))))
  '((moveto (1200 . -200))
    (lineto (1200 . 400))
    (lineto (800 . 400))
    (curveto (800 . 400) (500 . 400) (500 . 100))
    (curveto (500 . -200) (800 . -200) (800 . -200))
    (closepath)))
(test-equal (path-info (car (mirror-objects! -500 (new-path))))
  '((moveto (-800 . -200))
    (lineto (-800 . 400))
    (lineto (-1200 . 400))
    (curveto (-1200 . 400) (-1500 . 400) (-1500 . 100))
    (curveto (-1500 . -200) (-1200 . -200) (-1200 . -200))
    (closepath)))
;;; Double mirror around the same point returns initial result.
(test-equal (path-info
             (car (mirror-objects! 500
                                   (car (mirror-objects! 500 (new-path))))))
  '((moveto (-200 . -200))
    (lineto (-200 . 400))
    (lineto (200 . 400))
    (curveto (200 . 400) (500 . 400) (500 . 100))
    (curveto (500 . -200) (200 . -200) (200 . -200))
    (closepath)))

(test-end "path-mirror")


(test-begin "path-rotation")

(define degree-ls
  '(-900 -360 -270 -180 -90 0 90 180 270 360 900))

(define (rotate-at+500+500 angle)
  (path-info (car (rotate-objects! '(500 . 500) angle (new-path)))))
(define (rotate-at-500+500 angle)
  (path-info (car (rotate-objects! '(-500 . 500) angle (new-path)))))
(define (rotate-at+500-500 angle)
  (path-info (car (rotate-objects! '(500 . -500) angle (new-path)))))
(define (rotate-at-500-500 angle)
  (path-info (car (rotate-objects! '(-500 . -500) angle (new-path)))))

(test-equal (map rotate-at+500+500 degree-ls)
  '(((moveto (1200 . 1200))
     (lineto (1200 . 600))
     (lineto (800 . 600))
     (curveto (800 . 600) (500 . 600) (500 . 900))
     (curveto (500 . 1200) (800 . 1200) (800 . 1200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (1200 . -200))
     (lineto (600 . -200))
     (lineto (600 . 200))
     (curveto (600 . 200) (600 . 500) (900 . 500))
     (curveto (1200 . 500) (1200 . 200) (1200 . 200))
     (closepath))
    ((moveto (1200 . 1200))
     (lineto (1200 . 600))
     (lineto (800 . 600))
     (curveto (800 . 600) (500 . 600) (500 . 900))
     (curveto (500 . 1200) (800 . 1200) (800 . 1200))
     (closepath))
    ((moveto (-200 . 1200))
     (lineto (400 . 1200))
     (lineto (400 . 800))
     (curveto (400 . 800) (400 . 500) (100 . 500))
     (curveto (-200 . 500) (-200 . 800) (-200 . 800))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (1200 . -200))
     (lineto (600 . -200))
     (lineto (600 . 200))
     (curveto (600 . 200) (600 . 500) (900 . 500))
     (curveto (1200 . 500) (1200 . 200) (1200 . 200))
     (closepath))
    ((moveto (1200 . 1200))
     (lineto (1200 . 600))
     (lineto (800 . 600))
     (curveto (800 . 600) (500 . 600) (500 . 900))
     (curveto (500 . 1200) (800 . 1200) (800 . 1200))
     (closepath))
    ((moveto (-200 . 1200))
     (lineto (400 . 1200))
     (lineto (400 . 800))
     (curveto (400 . 800) (400 . 500) (100 . 500))
     (curveto (-200 . 500) (-200 . 800) (-200 . 800))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (1200 . 1200))
     (lineto (1200 . 600))
     (lineto (800 . 600))
     (curveto (800 . 600) (500 . 600) (500 . 900))
     (curveto (500 . 1200) (800 . 1200) (800 . 1200))
     (closepath))))

(test-equal (map rotate-at-500+500 degree-ls)
  '(((moveto (-800 . 1200))
     (lineto (-800 . 600))
     (lineto (-1200 . 600))
     (curveto
      (-1200 . 600)
      (-1500 . 600)
      (-1500 . 900))
     (curveto
      (-1500 . 1200)
      (-1200 . 1200)
      (-1200 . 1200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (200 . 800))
     (lineto (-400 . 800))
     (lineto (-400 . 1200))
     (curveto
      (-400 . 1200)
      (-400 . 1500)
      (-100 . 1500))
     (curveto (200 . 1500) (200 . 1200) (200 . 1200))
     (closepath))
    ((moveto (-800 . 1200))
     (lineto (-800 . 600))
     (lineto (-1200 . 600))
     (curveto
      (-1200 . 600)
      (-1500 . 600)
      (-1500 . 900))
     (curveto
      (-1500 . 1200)
      (-1200 . 1200)
      (-1200 . 1200))
     (closepath))
    ((moveto (-1200 . 200))
     (lineto (-600 . 200))
     (lineto (-600 . -200))
     (curveto
      (-600 . -200)
      (-600 . -500)
      (-900 . -500))
     (curveto
      (-1200 . -500)
      (-1200 . -200)
      (-1200 . -200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (200 . 800))
     (lineto (-400 . 800))
     (lineto (-400 . 1200))
     (curveto
      (-400 . 1200)
      (-400 . 1500)
      (-100 . 1500))
     (curveto (200 . 1500) (200 . 1200) (200 . 1200))
     (closepath))
    ((moveto (-800 . 1200))
     (lineto (-800 . 600))
     (lineto (-1200 . 600))
     (curveto
      (-1200 . 600)
      (-1500 . 600)
      (-1500 . 900))
     (curveto
      (-1500 . 1200)
      (-1200 . 1200)
      (-1200 . 1200))
     (closepath))
    ((moveto (-1200 . 200))
     (lineto (-600 . 200))
     (lineto (-600 . -200))
     (curveto
      (-600 . -200)
      (-600 . -500)
      (-900 . -500))
     (curveto
      (-1200 . -500)
      (-1200 . -200)
      (-1200 . -200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (-800 . 1200))
     (lineto (-800 . 600))
     (lineto (-1200 . 600))
     (curveto
      (-1200 . 600)
      (-1500 . 600)
      (-1500 . 900))
     (curveto
      (-1500 . 1200)
      (-1200 . 1200)
      (-1200 . 1200))
     (closepath))))

(test-equal (map rotate-at+500-500 degree-ls)
  '(((moveto (1200 . -800))
     (lineto (1200 . -1400))
     (lineto (800 . -1400))
     (curveto
      (800 . -1400)
      (500 . -1400)
      (500 . -1100))
     (curveto (500 . -800) (800 . -800) (800 . -800))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (200 . -1200))
     (lineto (-400 . -1200))
     (lineto (-400 . -800))
     (curveto
      (-400 . -800)
      (-400 . -500)
      (-100 . -500))
     (curveto (200 . -500) (200 . -800) (200 . -800))
     (closepath))
    ((moveto (1200 . -800))
     (lineto (1200 . -1400))
     (lineto (800 . -1400))
     (curveto
      (800 . -1400)
      (500 . -1400)
      (500 . -1100))
     (curveto (500 . -800) (800 . -800) (800 . -800))
     (closepath))
    ((moveto (800 . 200))
     (lineto (1400 . 200))
     (lineto (1400 . -200))
     (curveto
      (1400 . -200)
      (1400 . -500)
      (1100 . -500))
     (curveto (800 . -500) (800 . -200) (800 . -200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (200 . -1200))
     (lineto (-400 . -1200))
     (lineto (-400 . -800))
     (curveto
      (-400 . -800)
      (-400 . -500)
      (-100 . -500))
     (curveto (200 . -500) (200 . -800) (200 . -800))
     (closepath))
    ((moveto (1200 . -800))
     (lineto (1200 . -1400))
     (lineto (800 . -1400))
     (curveto
      (800 . -1400)
      (500 . -1400)
      (500 . -1100))
     (curveto (500 . -800) (800 . -800) (800 . -800))
     (closepath))
    ((moveto (800 . 200))
     (lineto (1400 . 200))
     (lineto (1400 . -200))
     (curveto
      (1400 . -200)
      (1400 . -500)
      (1100 . -500))
     (curveto (800 . -500) (800 . -200) (800 . -200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (1200 . -800))
     (lineto (1200 . -1400))
     (lineto (800 . -1400))
     (curveto
      (800 . -1400)
      (500 . -1400)
      (500 . -1100))
     (curveto (500 . -800) (800 . -800) (800 . -800))
     (closepath))))

(test-equal (map rotate-at-500-500 degree-ls)
  '(((moveto (-800 . -800))
     (lineto (-800 . -1400))
     (lineto (-1200 . -1400))
     (curveto
      (-1200 . -1400)
      (-1500 . -1400)
      (-1500 . -1100))
     (curveto
      (-1500 . -800)
      (-1200 . -800)
      (-1200 . -800))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (-800 . -200))
     (lineto (-1400 . -200))
     (lineto (-1400 . 200))
     (curveto
      (-1400 . 200)
      (-1400 . 500)
      (-1100 . 500))
     (curveto (-800 . 500) (-800 . 200) (-800 . 200))
     (closepath))
    ((moveto (-800 . -800))
     (lineto (-800 . -1400))
     (lineto (-1200 . -1400))
     (curveto
      (-1200 . -1400)
      (-1500 . -1400)
      (-1500 . -1100))
     (curveto
      (-1500 . -800)
      (-1200 . -800)
      (-1200 . -800))
     (closepath))
    ((moveto (-200 . -800))
     (lineto (400 . -800))
     (lineto (400 . -1200))
     (curveto
      (400 . -1200)
      (400 . -1500)
      (100 . -1500))
     (curveto
      (-200 . -1500)
      (-200 . -1200)
      (-200 . -1200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (-800 . -200))
     (lineto (-1400 . -200))
     (lineto (-1400 . 200))
     (curveto
      (-1400 . 200)
      (-1400 . 500)
      (-1100 . 500))
     (curveto (-800 . 500) (-800 . 200) (-800 . 200))
     (closepath))
    ((moveto (-800 . -800))
     (lineto (-800 . -1400))
     (lineto (-1200 . -1400))
     (curveto
      (-1200 . -1400)
      (-1500 . -1400)
      (-1500 . -1100))
     (curveto
      (-1500 . -800)
      (-1200 . -800)
      (-1200 . -800))
     (closepath))
    ((moveto (-200 . -800))
     (lineto (400 . -800))
     (lineto (400 . -1200))
     (curveto
      (400 . -1200)
      (400 . -1500)
      (100 . -1500))
     (curveto
      (-200 . -1500)
      (-200 . -1200)
      (-200 . -1200))
     (closepath))
    ((moveto (-200 . -200))
     (lineto (-200 . 400))
     (lineto (200 . 400))
     (curveto (200 . 400) (500 . 400) (500 . 100))
     (curveto (500 . -200) (200 . -200) (200 . -200))
     (closepath))
    ((moveto (-800 . -800))
     (lineto (-800 . -1400))
     (lineto (-1200 . -1400))
     (curveto
      (-1200 . -1400)
      (-1500 . -1400)
      (-1500 . -1100))
     (curveto
      (-1500 . -800)
      (-1200 . -800)
      (-1200 . -800))
     (closepath))))

;;; Invalid rotation angles, not multiple of 90 degree.
(test-assert-thrown 'misc-error (rotate-at+500+500 100))
(test-assert-thrown 'misc-error (rotate-at+500+500 -100))
(test-assert-thrown 'misc-error (rotate-at+500+500 3000))
(test-assert-thrown 'misc-error (rotate-at+500+500 -3000))

(test-end "path-rotation")
